home *** CD-ROM | disk | FTP | other *** search
/ The 640 MEG Shareware Studio 2 / The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO / pascal / border80.zip / BORDER80.PAS
Pascal/Delphi Source File  |  1985-11-12  |  4KB  |  121 lines
  1. {DEMO OF TURBO PASCAL 2.0 80 COLUMN SCREEN BORDER COLOR CONTROL}
  2. {$C-}
  3. program border_color_test;
  4.  
  5. type ColorArray = array[0..15] of string[13];
  6.  
  7. const color:ColorArray = ('Black','Blue','Green','Cyan','Red','Magenta',
  8.                           'Brown','White','Gray','Light Blue','Light Green',
  9.                           'Light Cyan','Light Red','Light Magenta','Yellow',
  10.                           'Light White');
  11.  
  12. var
  13.   i,wait,offset:integer;
  14.   tempoffset:real;
  15.   ch:char;
  16.   colormessage:string[18];
  17.   num:string[3];
  18.  
  19. procedure GetInteger(var number:integer); {Protect against bad input}
  20.   type characters = set of char;
  21.   var buffer:string[4];ch:char;x,y,result:integer;numerals:characters;
  22.   begin
  23.     x:=wherex;y:=wherey;
  24.     numerals := ['0'..'9'];
  25.     buffer:='';
  26.     repeat
  27.       if keypressed then
  28.         begin
  29.           read(kbd,ch);
  30.           if ch in numerals then
  31.             begin
  32.               buffer:=buffer+ch;
  33.               write(ch);
  34.             end;
  35.           if ch=#27 then halt;
  36.           if ch=#8 then
  37.             begin
  38.               delete(buffer,length(buffer),1);
  39.               gotoxy(x,y);write(buffer,' ');gotoxy(wherex-1,y);
  40.             end;
  41.         end;
  42.     until (ch=#13) or (length(buffer)=4);
  43.     val(buffer,number,result);
  44.     if result <>0 then write('ERROR IN OBTAINING INTEGER!!');
  45.     if number>1000 then
  46.       begin
  47.         textcolor(14);
  48.         gotoxy(x,y);write('     ** 1000 maximum **');
  49.         textcolor(6);
  50.         gotoxy(x,y);GetInteger(number);
  51.         gotoxy(x+5,y);write('                  ');
  52.       end;
  53.     gotoxy(x,y);textcolor(11);write(number,'   ');textcolor(6);
  54.   end;
  55.  
  56. procedure CursorOff;
  57.   begin
  58.     port[$3d4]:=10;   { 6845 crt controller ind reg;points to reg to rec }
  59.     port[$3d5]:=9;    { data which is output to reg here;strt scan ln=9  }
  60.     port[$3d4]:=11;   { index to reg for cursor stop scan ln             }
  61.     port[$3d5]:=8;    { stop scan line=8                                 }
  62.  end;
  63.  
  64. procedure CursorOn;
  65.   begin
  66.     port[$3d4]:=10;
  67.     port[$3d5]:=6;    { start scan line = 6 ( normal ) }
  68.     port[$3d4]:=11;
  69.     port[$3d5]:=7;    { stop scan line = 7 ( normal )  }
  70.   end;
  71.  
  72. begin  {COLORTEST}
  73.   clrscr;
  74.   repeat
  75.     textmode(3);hirescolor(0);textcolor(6);
  76.     gotoxy(17,5);write('DEMO OF BORDER COLOR CHANGE IN TURBO PASCAL 2.0');
  77.     gotoxy(24,7);write('(applies to color-text-mode only)');
  78.     gotoxy(23,12);write('Input delay time (sec/1000) -- ');GetInteger(wait);
  79.     gotoxy(29,14);write('Press ');textcolor(30);write('<esc>');
  80.     textcolor(6);write(' to exit');
  81.     textcolor(0);textbackground(6);
  82.     gotoxy(28,16);write('╔════════════════════╗');
  83.     gotoxy(28,17);write('║                    ║');
  84.     gotoxy(28,18);write('╚════════════════════╝');
  85.     textbackground(0);
  86.     ch:=chr(0);
  87.     CursorOff;
  88.     repeat
  89.       i:=0;
  90.       while i < 16 do
  91.         begin
  92.           if i=0 then begin textcolor(0);textbackground(7);end
  93.             else begin textbackground(0);textcolor(i);end;
  94.           str(i,num);
  95.           colormessage:=' '+num+' '+color[i]+' ';
  96.           offset:=length(colormessage);
  97.           tempoffset:=offset/2;
  98.           offset:=trunc(tempoffset);
  99.           gotoxy(30,17);write('                  ');
  100.           gotoxy(39-offset,17);write(colormessage);
  101.           hirescolor(i);delay(wait);
  102.           if keypressed then read(kbd,ch);
  103.           if ch = #27 then i:=16;
  104.           i:=i+1;
  105.         end;
  106.     until ch = #27;
  107.     CursorOn;
  108.     hirescolor(0);textcolor(12);textbackground(0);
  109.     gotoxy(15,22);write('Repeat with different delay time (Y/N) ? ');
  110.     textcolor(10);read(kbd,ch);
  111.     if ch in ['Y','y'] then
  112.         begin
  113.           gotoxy(wherex,wherey);write('Yes');
  114.         end
  115.       else
  116.         begin
  117.           gotoxy(wherex,wherey);write('No');
  118.         end;
  119.     delay(750);
  120.   until not(ch in ['Y','y']);
  121. end.